home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
aie8911.zip
/
NEWTRACE.ARI
< prev
next >
Wrap
Text File
|
1989-08-27
|
16KB
|
587 lines
%%%%%%%%%% end prepcomp generated declarations %%%%%%%%%%%%%%%%%%%%
% :- module trace .
:- extrn har_global_value / 1 : interp.
:- extrn trace_trace / 0 : interp.
:- extrn non_empty / 1 : far.
%%%%%%%%%%%%%%%%%%%%%% end hand coded decs %%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%% start of version independent code %%%%%%%%%%%%%%
/*************************************************************************/
/************************ Top of trace.ari *************************/
/*************************************************************************/
/* trace_message(X) writes a user-defined trace message on the screen,
example:
trace_message([$X=$,X])
would write when X=3,
% **TRACE***: X=3
Note: a fancier version that writes also to a file is in Prolog Tools.
This short version saves scarce space in the interpreter.
*/
write_fact_trace(X) :-
call( write_fact_trace),
!,
trace_message(X).
write_fact_trace(_).
err_file_msg($Error file:$).
err_filename($err.log$).
log_file_msg($log file:$).
log_filename($log.log$).
trace_trace :- fail.
%%%%%%%%%%%%%%%%%%% msg_to_err_file %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
msg_to_err_file( X)
Writes a msg. X to both the screen and to the error file.
*/
msg_to_err_file( X) :-
get_err_handle(Handle),
trace_message_hlpr(Handle,X).
%%%%%%%%%%%%%%%%%%% trace_message %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
/*
trace_message(X)
Writes a msg. X to both the screen and to the log file.
*/
trace_message(Flag, Msg) :-
call( Flag), !,
( trace_message(Msg) , ! ; true).
trace_message( _ , Msg) :- !.
trace_message(X):-
(X==pause,!;
X==$pause$),!,
press_any.
trace_message(X):-
get_trace_handle(Handle),
% nl, write($+++++++ handle = $), write(Handle),
trace_message_hlpr(Handle,X).
trace_message_hlpr(Handle,X) :-
leadoff([1, Handle]),
trace_msg_hlpr2([1,Handle],X).
trace_msg_hlpr2( Handles ,[]) :- !,t_nl( Handles).
trace_msg_hlpr2( Handles ,[H|T]) :-
atomic( H),
!,
trace_msg_hlpr3( Handles ,[H|T]) .
trace_msg_hlpr2( Handles , X) :-
write_message( Handles, X ),
t_nl( Handles).
trace_msg_hlpr3( Handles ,[]) :- !,t_nl( Handles).
trace_msg_hlpr3( Handles ,[H|T]) :- !,
write_message( Handles, H ),!,
trace_msg_hlpr3( Handles, T ).
trace_msg_hlpr3( Handles, X ) :- trace_msg_hlpr3( Handles, [X] ),
!.
leadoff( [] ) :- !.
leadoff( [H | T ] ) :-
leadoff_hlpr(H),
leadoff(T).
leadoff_hlpr( X) :-
integer(X),
X > 1,
!,
t_nl([ X ]),
t_write( [ X ], $% **TRACE***: $).
leadoff_hlpr( X) :-
integer(X),
X = 1,
!,
bottom_row(Row),
tmove(Row,0),
write( $% **TRACE***: $).
leadoff_hlpr( _ ) :- !.
write_message(Handles,X) :- var(X),!, t_write(Handles,$VAR$).
write_message(Handles,X) :- is_nonempty_list(X),!, t_write_list(Handles,X).
write_message(Handles,X) :- write_message_hlpr(Handles,X).
% write_message_hlpr(Handle,X) :-
% nl, write($ write_message_hlpr : $), write( X),fail.
write_message_hlpr(Handles,X) :- string(X),!, t_write(Handles,X).
write_message_hlpr(Handles,X) :- var(X),!, t_write(Handles,$VAR$).
write_message_hlpr(Handles,X) :- t_writeq(Handles,X).
t_nl( []) :- !.
t_nl( [H | T ]) :-
!,
t_nl_hlpr( H),
t_nl( T ).
t_nl( X) :-
integer(X),
!,
t_nl([X]).
t_nl( _).
t_nl_hlpr( H ) :-
H >=0,! ,
nl(H ) ,
!.
t_nl_hlpr( _ ) :- !.
t_write( [ ], X) :-!.
t_write( [ H | T ], X) :-
t_write_hlpr( H, X ) ,
!,
t_write( T , X).
t_write( X) :-
integer(X),
!,
t_write([X]).
t_write( _) .
t_write_hlpr( H, X ) :-
H >=0,
! ,
write(H , X).
t_write_hlpr( _, _ ) :- !.
t_writeq( [ ], X) :-!.
t_writeq( [ H | T ], X) :-
t_writeq_hlpr( H, X ) ,
t_writeq( T , X).
t_writeq( X) :-
integer(X),
!,
t_writeq([X]).
t_writeq( _ ) :-!.
t_writeq_hlpr( H, X ) :-
H >=0,
! ,
write_fact_hlpr( H , X , 0, 0, 1, Used).
t_writeq_hlpr( _, _ ) :- !.
t_put( [], _) :- !.
t_put( [H|T], X) :-
put( H , X),
t_put( T, X).
t_tab( [], _) :- !.
t_tab( [H|T], X) :-
tab( H , X),
t_tab( T, X).
log_read_string( Lnth, String) :-
read_string( Lnth, String) ,
log_read_string_hlpr( String).
log_read_string_hlpr( String) :-
getglobal( log_file_handle, H),
H > 1,
t_write([ H], String),
nl( H ),
!.
log_read_string_hlpr( _ ) .
log_read( Expr ) :-
read( Expr ) ,
log_read_hlpr( Expr ).
log_read_hlpr( Expr ) :-
getglobal( log_file_handle, H),
H > 1,
t_writeq([ H], Expr ),
t_write([ H], $.$ ),
nl( H ),
!.
log_read_string_hlpr( _ ) .
log_writeq(X) :-
getglobal( log_file_handle, H),
H > 1,
!,
t_writeq([ 1, H],X).
log_writeq(X) :-
writeq(X).
log_write(X) :-
getglobal( log_file_handle, H),
H > 1,
!,
t_write([ 1, H],X).
log_write(X) :-
write(X).
log_nl :-
getglobal( log_file_handle, H),
H > 1,
!,
t_nl([ 1, H]).
log_nl :- nl.
log_put(X) :-
getglobal( log_file_handle, H),
H > 1,
!,
t_put([ 1, H], X).
log_put(X) :- put(X).
log_tab(X) :-
getglobal( log_file_handle, H),
H > 1,
!,
t_tab([ 1, H], X).
log_tab(X) :- tab(X).
log_writeln([]) :- !.
log_writeln([Head|Tail]) :- !, log_write(Head),
log_nl,
log_writeln(Tail).
log_writeln(Arg) :- log_write(Arg), log_nl.
t_write_list(Handles,[H|T]):-
% nl, write($ t_write_list : $), write( [H|T]) ,
t_write(Handles,$[$) , !,
write_message_hlpr(Handles,H), !,
t_write_list_hlpr(Handles,T).
t_write_list_hlpr(Handles,[]) :-
t_write(Handles,$]$) , !.
t_write_list_hlpr(Handles,[H|T]) :-
% nl, write($ t_write_list_hlpr : $), write( [H|T]) ,
t_write(Handles,$,$) , !,
tget(_,Col), !,
% nl, write($ a tget, Col = $), write( Col ) ,
t_write_list_cond_nl(Handles, Col),!,
write_message_hlpr(Handles,H), !,
t_write_list_hlpr(Handles,T) .
t_write_list_cond_nl(Handles, Col) :-
Col > 40, !,
t_nl(Handles),
t_write(Handles,$% $).
t_write_list_cond_nl(Handles, _ ):- t_write(Handles, $ $).
/*************************************************************************/
/*********************** Log file stuff ************************/
/*************************************************************************/
init_log_file :-
% call(log_filename(File)),
log_filename(File) ,
% call(log_file_msg(Msg)),
log_file_msg(Msg) ,
init_file(File, log_file_handle, Msg).
init_err_file :-
% call(err_filename(File)),
% call(err_file_msg(Msg )),
err_filename(File ),
err_file_msg(Msg ) ,
init_file(File, err_file_handle, Msg).
init_file(File, Variable, Msg) :-
create(Handle,File),
close(Handle),
open( Handle2,File, ra),
setglobal(Variable, Handle2),
% nl, write($+++++++ $), write(Variable),
% write($ handle = $), write(Handle),
(trace_trace, !,
trace_message([Msg]);
true).
close_log_file :- close_file( log_file_handle ).
close_err_file :- close_file( err_file_handle ).
close_file( Variable) :-
getglobal(Variable, Handle),
close( Handle),
rem_global_value( Variable ).
get_trace_handle(Handle) :-
getglobal(log_file_handle, Handle),!.
get_trace_handle( -1 ) :- !.
get_err_handle(Handle) :-
getglobal(err_file_handle, Handle),!.
get_err_handle( -1 ) :- !.
err_log( X) :-
getglobal(err_file_handle, Handle),
trace_message_hlpr(Handle,X).
%%%%%%%%%%%%%%%% global variable predicates %%%%%%%%%%%%%%%%%%%%%%%
% note variable in the following refers to a PROLOG ATOM used as
% a global varible in the application.
%%%%%%%%%%%%%%%% setglobal : set value of global variable %%%%%%%%%%
setglobal( Var, Val ) :-
rem_global_value( Var),
Form =.. [Var, Val],
asserta( Form),
let_have_global_value( Var).
let_have_global_value( Var) :-
asserta(har_global_value( Var)).
%%%%%%%%%%%%%%%% getglobal : get value of global variable %%%%%%%%%%
getglobal( Var, Val) :-
has_global_value( Var),
Form =.. [Var, Val],
call( Form).
%%%%%%%%%%%%%%%% has_global_value : true if variable has global value %%%%%
has_global_value( Var) :-
call(har_global_value( Var)).
%%%%%%%%%%%%%%%% rem_global_value : remove global value %%%%%%%%%%%%%%%%%%%
rem_global_value( Var) :-
has_global_value( Var),
Form =.. [Var, _],
retract( Form),
retract( har_global_value( Var)),!.
rem_global_value( _ ).
/*************************************************************************/
/******* is_nonempty_list : true if argument is a non-empty list *********/
/*************************************************************************/
is_nonempty_list([_|_]).
/* test
tt :- init_log_file,
trace_message($hi there$),
close_log_file,
shell($type log.log$).
*/
bottom_row(Row) :-
tget(R,C),
% make cursor invisible for search on screen
hide_cursor,
bottom_row_hlpr(24,Row),
% make cursor visible after search on screen
restore_cursor,
tmove(R,C).
bottom_row_hlpr(Cur, Cur):-
tmove( Cur,0),!.
bottom_row_hlpr(Cur,Row) :-
Cur1 is Cur-1,
bottom_row_hlpr(Cur1,Row).
/************ press key to continue ***********************************/
press_any :- % message about pressing key
trace_message($Press any key to continue ...$),
% get user keystroke without echo
flush,
get0_noecho( _ ) .
/************ log_listing ***********************************************/
log_listing( When, What ) :-
call( When),
!,
log_listing( What) .
log_listing( _, _ ) :- !.
log_listing( Name / Arity) :-
getglobal( log_file_handle, H),
int_text( Arity, S_arity),
concat([$Listing of $,Name, $ / $,S_arity,$ :$],Msg),
log_write( Msg),
log_nl,
functor( Term, Name, Arity),
clause( Term, Body),
write_message_hlpr([ 1, H], ( Term :- Body) ),
log_nl,
nl,
fail.
log_listing( _ ).
/******** write_fact *************************************************/
/* writess a fact to where it belongs.
CALL : write_fact ( Out_handle, Fact)
INPUT ARGS:
Out_handle : where output goes, either file handle or
prolog_idb
Fact : what to write out
*/
:- mode write_fact( +, +).
write_fact( Out_handle, Fact) :-
write_fact_trace([$i write_fact, Out_handle = $, Out_handle]),
fail.
write_fact( Out_handle, Fact) :-
means_put_in_prolog_idb( Out_handle) ,
!,
assertz( Fact).
write_fact( Out_handle, Fact) :-
write_fact_hlpr( Out_handle, Fact, 0, 0, 1, Used),
write( Out_handle, $.$),
nl( Out_handle ),
( Used > 1, !, nl(Out_handle)
; true).
write_fact_hlpr( Out_handle, Fact, Indent, Current, Lines_used,
Total_lines) :-
Tabs is Indent - Current,
tab(Out_handle, Tabs),
string_term( Sfact, Fact),
string_length( Sfact, Factlnth),
OK is 76 - Indent,
( Factlnth =< OK,
!,
writeq( Out_handle, Fact),
Total_lines is Lines_used
;
write_fact_hlpr2( Out_handle, Fact, Indent,
Indent , Lines_used, Total_lines)).
% this rule writes atoms
write_fact_hlpr2( Out_handle, Fact, _ , _ , Lines_in, Lines_in) :-
atomic( Fact),
!,
writeq( Out_handle, Fact) .
% this rule writes frame slot : value pairs
write_fact_hlpr2( Out_handle, S:V , N, Current , Lines_used, Total_lines) :-
!,
write_fact_hlpr( Out_handle, S, N, Current, Lines_used, Sofar1),
write(Out_handle, $ : $),
nl( Out_handle),
N3 is N+3,
write_fact_hlpr( Out_handle, V, N3, 0, Sofar1, Total_lines).
write_fact_hlpr2( Out_handle, [H|T], N, Current , Lines_used, Total_lines) :-
!,
write(Out_handle, $[$),
NewN is N + 1,
Current1 is Current+1,
write_arg( Out_handle, H, T, NewN, Current1, Lines_used, Sofar),
write_fact_hlpr3( Out_handle, T, NewN, 0, Sofar, Total_lines),
write( Out_handle, $]$).
write_fact_hlpr2( Out_handle, Fact, N, Current, Used, Total ) :-
Fact =..[ Functor | Args],
atom_string( Functor, Sfunctor),
string_length( Sfunctor, Functor_lnth),
write(Out_handle, Functor),
write(Out_handle, $($),
NewN is N + Functor_lnth + 1,
New_used is Used + 1,
Current1 is Current+ Functor_lnth +1,
write_args( Out_handle, Args, NewN, Current1, New_used, Total).
write_args( Out_handle, [], _, _, Used, Used ) :- !.
write_args( Out_handle, [Arg | Rest], N, Current, Used, Total) :-
write_arg( Out_handle, Arg, Rest, N, Current, Used , Sofar),
write_fact_hlpr3( Out_handle, Rest, N, 0, Sofar, Total),
write( Out_handle, $)$).
write_fact_hlpr3( Out_handle, [], _ , _, Used, Used) :- !.
write_fact_hlpr3( Out_handle, [H|T], NewN, Current, Used, Total) :-
Tabs is NewN - Current,
tab( Out_handle, Tabs),
write_arg( Out_handle, H , T, NewN , NewN, Used, Sofar),
write_fact_hlpr3( Out_handle, T, NewN, 0, Sofar, Total ).
write_arg( Out_handle, Arg, Rest, N , Current, Sofar, Total) :-
write_fact_hlpr( Out_handle, Arg, N, Current, Sofar, Sofar1),
( non_empty( Rest ),
!,
write( Out_handle, $,$),
nl( Out_handle),
Total is Sofar1 + 1
;
true,
Total is Sofar1
).
/************ means_put_in_prolog_idb ****************************/
/* atoms that mean put the stuff in the prolog database instead of
a file.
*/
means_put_in_prolog_idb( X ) :-
write_fact_trace([$e means_put_in_prolog_idb , Arg = $, X]),
fail.
means_put_in_prolog_idb( prolog_idb) :- !.
means_put_in_prolog_idb( String ) :-
string( String),
string_search( prolog_idb, String, _),!.
/********************** end of file **************************************/
/********************** end of file **************************************/